home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / obsolete / tiff_read.pro < prev    next >
Text File  |  1997-07-08  |  11KB  |  341 lines
  1. ; $Id: tiff_read.pro,v 1.2 1997/01/15 04:02:19 ali Exp $
  2. ;
  3. ; Copyright (c) 1991-1997. Research Systems, Inc. All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5. ;+
  6. ; NAME:
  7. ;    TIFF_READ
  8. ;
  9. ; PURPOSE:
  10. ;    Read TIFF format images.
  11. ;
  12. ; CATEGORY:
  13. ;    Input/output.
  14. ;
  15. ; CALLING SEQUENCE:
  16. ;   Result = TIFF_READ(Filename [,R, G, B])
  17. ;
  18. ; INPUTS:
  19. ;    Filename:    A string containing the name of file to read.
  20. ;        The default extension is ".TIF".
  21. ;
  22. ; OUTPUTS:
  23. ;    TIFF_READ returns an 8, 16, or 32-bit array containing the image
  24. ;    data.  The dimensions of the result are the same as defined in the TIFF 
  25. ;    file: [Columns, Rows].  The data type of the image is same as
  26. ;    the type of samples in the image file.
  27. ;
  28. ;    For TIFF images that are RGB interleaved by pixel, the output 
  29. ;    dimensions are [3, Cols, Rows].
  30. ;
  31. ;    For TIFF images that are RGB interleaved by image, on output
  32. ;    Planarconfig is set to 2, and the result is the integer value
  33. ;    zero.   In this case, three separate images are returned in
  34. ;    the R, G, and B output parameters.
  35. ;
  36. ; OPTIONAL OUTPUTS:
  37. ;     R, G, B:    Variables to hold the Red, Green, and Blue color vectors
  38. ;        extracted from TIFF Class P, Palette Color images.
  39. ;    For TIFF images that are RGB interleaved by image (Planarconfig
  40. ;    returned as 2) the R, G, and B variables each hold an image
  41. ;    with the dimensions [Columns, Rows].
  42. ;
  43. ; KEYWORDS:
  44. ;    UNSIGNED: If set, return TIFF files containing unsigned 16-bit integers
  45. ;        as signed 32-bit longword arrays.  If not set, return 
  46. ;        a signed 16-bit integer for these files.  In this case,
  47. ;        data values between 32768 and 65535 are returned as 
  48. ;        negative values between -32768 and -1.  This keyword
  49. ;        has no effect if the input file does not contain 16-bit
  50. ;        integers.   To manually convert unsigned 16-bit to 32-bit:
  51. ;            l32 = long(u16)
  52. ;            neg = where(l32 lt 0, count)
  53. ;            if count ne 0 then l32[neg] = 65536 + l32[neg]
  54. ;
  55. ;    The following keywords are used for output parameters only:
  56. ;
  57. ;    ORDER:    The order parameter from the TIFF File.  This parameter is
  58. ;        returned as 0 for images written bottom to top, and 1 for
  59. ;        images written top to bottom.  If the Orientation parameter 
  60. ;        does not appear in the TIFF file, an order of 1 is returned.
  61. ;
  62. ; PLANARCONFIG:    This parameter is returned as 1 for TIFF files that are
  63. ;        GrayScale, Palette, or RGB color interleaved by pixel.  
  64. ;        This parameter is returned as 2 for RGB color TIFF files 
  65. ;        interleaved by image.
  66. ;
  67. ; COMMON BLOCKS:
  68. ;    TIFF_COM.  Only for internal use.
  69. ;
  70. ; SIDE EFFECTS:
  71. ;    A file is read.
  72. ;
  73. ; RESTRICTIONS:
  74. ;    Handles TIFF classes G, P, and R.  One image per file.
  75. ;
  76. ; EXAMPLE:
  77. ;    Read the file "my.tiff" in the current directory into the variable
  78. ;    IMAGE, and save the color tables in the variables, R, G, and B by
  79. ;    entering:
  80. ;
  81. ;        IMAGE = TIFF_READ("my.tiff", R, G, B)
  82. ;
  83. ;    To view the image, load the new color table and display the image by
  84. ;    entering:
  85. ;
  86. ;        TVLCT, R, G, B
  87. ;        TV, IMAGE 
  88. ;
  89. ;
  90. ; MODIFICATION HISTORY:
  91. ;    DMS, Written for VMS in 1985.
  92. ;    DMS, April, 1991.  Rewrote and added class R and P images.
  93. ;    DMS, Jan, 1992.  Fixed bug for images without a RowsPerStrip field.
  94. ;       DJC, Nov, 1993.  Fixed doc header.
  95. ;    DMS, Dec, 1994.     Fixed bug with private tags.
  96. ;    MWR, Mar, 1995.  Fixed bug when opening non-existent file.
  97. ;    DMS, Aug, 1995.  Added support for 16 and 32 bit samples.
  98. ;    DMS, Aug, 1996.  Added UNSIGNED keyword.
  99. ;-
  100.  
  101. function tiff_long,a,i,len=len    ;return longword(s) from array a(i)
  102. common tiff_com, order, ifd, count
  103.  
  104. on_error,2              ;Return to caller if an error occurs
  105.  
  106.    if n_elements(len) le 0 then len = 1
  107.    if len gt 1 then result = long(a,i,len) $
  108.    else result = long(a,i)
  109.    if order then byteorder, result, /lswap
  110.    return, result
  111. end
  112.  
  113.  
  114. function tiff_rational,a,i, len = len      ; return rational from array a(i)
  115. common tiff_com, order, ifd, count
  116.  
  117. on_error,2              ;Return to caller if an error occurs
  118.  
  119. if n_elements(len) le 0 then len = 1
  120. tmp = tiff_long(a, i, len = 2 * len)    ;1st, cvt to longwords
  121. if len gt 1 then begin
  122.     subs = lindgen(len)
  123.     rslt = float(tmp[subs*2]) / tmp[subs*2+1]
  124. endif else rslt = float(tmp[0]) / tmp[1]
  125. return, rslt
  126. end
  127.  
  128. function tiff_int,a,i, len=len    ;return unsigned long int from TIFF short int
  129. common tiff_com, order, ifd, count
  130.  
  131. on_error,2              ;Return to caller if an error occurs
  132. if n_elements(len) le 0 then len = 1
  133. if len gt 1 then begin    ;Array?
  134.     result = fix(a,i,len)
  135.     if order then byteorder, result, /sswap
  136.     result = long(result)
  137.     if min(result) lt 0 then begin    ;Convert to unsigned from signed 16bit
  138.       negs = where(result lt 0)
  139.       result[negs] = 65536L + result[negs]
  140.       endif
  141. endif else begin    ;Scalar
  142.     result = fix(a,i)
  143.     if order then byteorder, result, /sswap
  144.     if result lt 0 then result = 65536L + result
  145. endelse
  146. return, result
  147. end
  148.  
  149. function tiff_byte, a,i,len=len    ;return bytes from array a(i)
  150. common tiff_com, order, ifd, count
  151.  
  152. on_error,2              ;Return to caller if an error occurs
  153.  
  154.    if n_elements(len) le 0 then len = 1
  155.    if len gt 1 then result = a[i:i+len-1] $
  156.    else result = a[i]
  157.    return, result
  158. end
  159.  
  160. function tiff_read_field, index, tag, lun  ;Return contents of field index
  161. ; On output, tag = tiff tag index.
  162. ;
  163. common tiff_com, order, ifd, count
  164.  
  165.  
  166. on_error,2                      ;Return to caller if an error occurs
  167. TypeLen = [0, 1, 1, 2, 4, 8] ;lengths of tiff types, 0 is null type for indexin
  168.  
  169. ent = ifd[index * 12: index * 12 + 11]  ;Extract the ifd
  170. tag = tiff_int(ent, 0)        ;Tiff tag index
  171. typ = tiff_int(ent, 2)        ;Tiff data type
  172. cnt = tiff_long(ent, 4)        ;# of elements
  173. nbytes = cnt * TypeLen[typ]    ;Size of tag field
  174. IF (nbytes GT 4) THEN BEGIN     ;value size > 4 bytes ?
  175.         offset = tiff_long(ent, 8)    ;field has offset to value location
  176.         Point_Lun, lun, offset
  177.         val = BytArr(nbytes)     ;buffer will hold value(s)
  178.         Readu, lun, val
  179.         CASE typ OF        ;Ignore bytes, as there is nothing to do
  180.        1: i = 0        ;Dummy
  181.            2: val = String(val)        ;tiff ascii type
  182.            3: val = tiff_int(val,0, len = cnt)
  183.        4: val = tiff_long(val,0, len = cnt)
  184.            5: val = tiff_rational(val,0, len = cnt)
  185.     ENDCASE
  186. ENDIF ELSE BEGIN            ;Scalar...
  187.         CASE typ OF
  188.        1: val = ent[8]
  189.          2: val = string(ent[8:8+(cnt>1)-1])
  190.        3: val = tiff_int(ent,8)
  191.        4: val = tiff_long(ent,8)
  192.         ENDCASE
  193.      ENDELSE
  194. return, val
  195. end
  196.  
  197.  
  198.  
  199.  
  200. function tiff_read, file, r, g, b, order = ord, PlanarConfig = PC, $
  201.     UNSIGNED=unsigned
  202. common tiff_com, order, ifd, count
  203.  
  204.  
  205. on_error,2                      ;Return to caller if an error occurs
  206.  
  207. openr,lun,file, error = i, /GET_LUN, /BLOCK
  208. if i lt 0 then begin ;OK?
  209.     if keyword_set(lun) then free_lun,lun
  210.     lun = -1
  211.     message, 'Unable to open file: ' + file
  212.     endif
  213.  
  214. hdr = bytarr(8)            ;Read the header
  215. readu, lun, hdr
  216.  
  217. typ = string(hdr[0:1])        ;Either MM or II
  218. if (typ ne 'MM') and (typ ne 'II') then begin
  219.     message,'TIFF_READ: File is not a Tiff file: ' + string(file)
  220.     return,0
  221.     endif
  222. order = typ eq 'MM'          ;1 if Motorola 0 if Intel (LSB first or vax)
  223. endian = byte(1,0,2)        ;What endian is this?
  224. endian = endian[0] eq 0        ;1 for big endian, 0 for little
  225. order = order xor endian    ;1 to swap...
  226.  
  227. ; print,'Tiff File: byte order=',typ, ',  Version = ', tiff_int(hdr,2)
  228.  
  229. offs = tiff_long(hdr, 4)    ;Offset to IFD
  230.  
  231. point_lun, lun, offs        ;Read it
  232.  
  233. a = bytarr(2)            ;Entry count array
  234. readu, lun, a
  235. count = tiff_int(a,0)        ;count of entries
  236. ; print,count, ' directory entries'
  237. ifd = bytarr(count * 12)    ;Array for IFD's
  238. readu, lun, ifd            ;read it
  239.  
  240. ;    Insert default values:
  241. compression = 1
  242. bits_sample = 1
  243. ord = 1
  244. samples_pixel = 1L
  245. pc = 1
  246. photo = 1
  247. rows_strip = 'fffffff'xl    ;Essentially infinity
  248. SampleFormat = 1
  249.  
  250. for i=0,count-1 do begin    ;Print each directory entry
  251.     value = tiff_read_field(i, tag, lun)  ;Get each parameter
  252.     case tag of    ;Decode the tag fields, other tags could be added
  253. 256:    width = value
  254. 257:    length = value
  255. 258:    bits_sample = value[0]
  256. 259:    compression = value
  257. 262:    Photo = value
  258. 273:    StripOff = value
  259. 274:    Ord = value
  260. 277:    samples_pixel = long(value)
  261. 278:    Rows_strip = value
  262. 279:    Strip_bytes = value
  263. 284:    PC = value
  264. 320:    ColorMap = value
  265. 339:    SampleFormat = value
  266. else:   value = 0        ;Throw it away
  267.     endcase
  268. endfor    
  269.  
  270. ;    Do a cursory amount of checking:
  271.     if bits_sample eq 8 then type = 1 $    ;Byte type
  272.     else if bits_sample eq 16 then type = 2 $    ;Short int type
  273.     else if bits_sample eq 32 and SampleFormat le 2 then type = 3 $ ;Long int
  274.     else message,'TIFF_READ: only integer format image handled'
  275.     if compression ne 1 then $
  276.     message,'TIFF_READ: Images must be un-compressed'
  277.     if (pc eq 2) and (samples_pixel ne 3) then $
  278.     message,'TIFF_READ: RGB data must have 3 SamplesPerPlane'
  279.     
  280. strips_image = (length + rows_strip -1) / rows_strip
  281. dims = [width, length]
  282. bytes_sample = bits_sample/8
  283.  
  284. if pc eq 1 then begin    ;Planar Config...., simple
  285.     if samples_pixel gt 1 then dims = [samples_pixel, dims]
  286.     image = make_array(DIMENSION=dims, TYPE=type,  /NOZERO)
  287.     if strips_image eq 1 then begin    ;Quick way?
  288.     point_lun, lun, stripoff[0]   ;1st image data
  289.     readu, lun, image     ;Yes....
  290.     endif else begin        ;1 strip at a time....
  291.     for i=0L, strips_image-1 do begin
  292.         point_lun, lun, stripoff[i]
  293.         if n_elements(tmp)*bytes_sample ne Strip_bytes[i] Then $
  294.           tmp = make_array(Strip_bytes[i]/bytes_sample, TYPE=type, /NOZERO)
  295.         readu, lun, tmp
  296.         image[samples_pixel * width * i * rows_strip] = tmp
  297.         endfor
  298.     endelse
  299.     if n_elements(ColorMap) gt 0 then begin    ;Color map present?
  300.        if n_elements(ColorMap) eq 768 then begin
  301.         r = ishft(ColorMap[0:255], -8) ;Remove and scale
  302.         g = ishft(ColorMap[256:511], -8)
  303.         b = ishft(ColorMap[512:767], -8)
  304.         endif else message,'TIFF_READ: color map has wrong # of elements'
  305.     endif
  306.  
  307.     if order and (bytes_sample eq 2) then BYTEORDER, image, /SSWAP
  308.     if order and (bytes_sample eq 4) then BYTEORDER, image, /LSWAP
  309.  
  310. endif else begin            ;PC = 2, = interleaved by image
  311.     l = 0
  312.     for band = 0,2 do begin        ;Read each image
  313.     image = make_array(DIMENSION=dims, TYPE=type,  /NOZERO)
  314.     for i=0L, strips_image-1 do begin
  315.         point_lun, lun, stripoff[l]
  316.         if n_elements(tmp)*bytes_sample ne Strip_bytes[l] then $
  317.           tmp = make_array(Strip_bytes[i]/bytes_sample, TYPE=type, /NOZERO)
  318.         readu, lun, tmp
  319.         image[width * i * rows_strip] = tmp
  320.         l = l + 1
  321.         endfor        ;Each strip
  322.     if order and (bytes_sample eq 2) then BYTEORDER, image, /SSWAP
  323.     if order and (bytes_sample eq 4) then BYTEORDER, image, /LSWAP
  324.     case band of
  325.       0: r = temporary(image)
  326.       1: g = temporary(image)
  327.       2: b = temporary(image)
  328.         endcase
  329.     endfor                ;Each band
  330. endelse                    ;PC = 2
  331.     
  332. if bits_sample eq 16 and keyword_set(unsigned) then begin
  333.     image = long(image)
  334.     neg = where(image lt 0, count)
  335.     if count gt 0 then image[neg] = 65536L + image[neg]
  336.     endif
  337.  
  338. free_lun, lun
  339. return, image
  340. end
  341.